home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / hf / tmuf / pro.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1988-03-22  |  5.9 KB  |  252 lines
  1. 0   COLOR 14,1,0
  2. 1  CLS
  3. 2  REM chr$(147) :print:print:print
  4. 3  PRINT TAB(31):PRINT "PROPOGATION PRO":PRINT TAB(38):PRINT"BY":PRINT TAB(29):PRINT"COMPOST DATA SYSTEMS":PRINT TAB(32):PRINT"COPYWRITE 1988"
  5. 4  PRINT:PRINT:PRINT:PRINT
  6. 5  PRINT TAB(9):PRINT"THIS PROGRAM WILL CALCULATE THE MAXIMUM USEABLE FREQUENCY FOR RADIO TRANSMISSION"
  7. 6  PRINT TAB(9):PRINT"FROM PITTSBURGH TO VARIOUS WORLD LOCATIONS AND TO SPECIFIC LOCATIONS OF KNOWN"
  8. 7  PRINT:PRINT TAB(28):PRINT"LATITUDE AND LONGITUDE.":PRINT
  9. 8  FOR I=1 TO 10000:NEXT I
  10. 9  CLS
  11. 110  DIM DM(12),M0$(12)
  12. 120  DATA 31,28,31,30,31,30,31,31,30,31,30,31
  13. 130  FOR I=1 TO 12: READ DM(I):NEXT I
  14. 140  DATA JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC
  15. 145  FOR I=1 TO 12:READ M0$(I):NEXT I
  16. 150  R0 = 3.1416/180
  17. 155  P1=2*3.1416
  18. 160  R1=180/3.1416
  19. 170  P0=3.1416/2
  20. 190  L1=40:W1=  + 80
  21. 191  PRINT TAB(29);"RECEIVER LOCATION":PRINT:PRINT
  22. 192  PRINT TAB(31);"ETR 1 ENGLAND"
  23. 193  PRINT TAB(31);"ETR 2 ITALY"
  24. 194  PRINT TAB(31);"ETR 3 TURKEY"
  25. 195  PRINT TAB(31);"ETR 4 EGYPT"
  26. 196  PRINT TAB(31);"ETR 5 SO.AFRICA"
  27. 197  PRINT TAB(31);"ETR 6 NEW ZEALAND"
  28. 198  PRINT TAB(31);"ETR 7 AUSTRALIA"
  29. 199  PRINT TAB(31);"ETR 8 JAPAN"
  30. 200  PRINT TAB(31);"ETR 9 HAWAI"
  31. 201  PRINT TAB(31);"ETR 10 ALASKA"
  32. 202  PRINT TAB(31);"ETR 11 GREENLAND"
  33. 203  PRINT TAB(31);"ETR 12 BRAZIL"
  34. 204  PRINT TAB(31);"ETR 13 SPECIFIC COORDINATES":PRINT TAB(31);"LONGITUDE WEST-ETR PLUS VALUE"
  35. 205  PRINT:PRINT:PRINT TAB(24):INPUT"ETR RECEIVER LOCATION CODE=";Z
  36. 206  CLS
  37. 207  GOSUB 4999
  38. 269  PRINT
  39. 349  PRINT:PRINT
  40. 350  PRINT TAB(1):INPUT"ENTER DAY, MONTH(31,12)";D6,M
  41. 351  M0=M
  42. 370  IF 1<=M AND M< =12 THEN 400
  43. 380  PRINT "INVALID MONTH (MUST BE IN RANGE OF 1 TO 12)"
  44. 390  GOTO 350
  45. 400  IF 1<=D6 AND D6 <=DM(M) THEN 411
  46. 405  PRINT "INVALID DAY ENTRY(RANGE 1-31)"
  47. 406  GOTO 350
  48. 410  PRINT ;PRINT;" DATA:M0;D6:PRINT"
  49. 411  PRINT:PRINT
  50. 430  PRINT TAB(1):INPUT "SOLAR FLUX NUMBER=";S
  51. 431  CLS
  52. 440  IF S>0 THEN 480
  53. 460  PRINT "INVALID SUNSPOT NO(POS NUMBER)"
  54. 470  GOTO 430
  55. 480  GOSUB 4000
  56. 490  PRINT : PRINT
  57. 500  PRINT "    DATE:";M0$(M);" ";D6;SPC(10);"SUNSPOT NO.  =";S9;
  58. 502  PRINT SPC(5);"SOLAR FLUX NO. = ";S:PRINT
  59. 510  PRINT TAB(22);"TRANS.LOC.-LAT=";L1;SPC(4);"LONG   =";W1
  60. 520  PRINT TAB(22);"RECVR.LOC.-LAT=";L2;SPC(4);"LONG   =";W2
  61. 521  PRINT
  62. 553  PRINT TAB(25);CT$
  63. 554  PRINT
  64. 560  PRINT ; TAB( 10);"  HOUR        MUF(MHZ)";
  65. 561  PRINT ; TAB( 40);"  HOUR        MUF(MHZ)"
  66. 570  PRINT
  67. 600  L1=L1*R0
  68. 610  W1=W1*R0
  69. 620  L2=L2*R0
  70. 630  W2=W2*R0
  71. 640  FOR Z5=0 TO 11
  72. 641  T5=Z5:S5=T5
  73. 650  GOSUB 1000
  74. 651  J9=INT(J9*100)/100:Z9=J9
  75. 653  T5=Z5+12:S6=T5
  76. 654  GOSUB 1000
  77. 655  J9=INT(J9*100)/100
  78. 660  PRINT TAB(14);S5;TAB(23);USING"###.#";Z9;
  79. 661  PRINT TAB(43);S6;TAB(53);USING"###.#";J9
  80. 680  NEXT Z5
  81. 690  PRINT
  82. 700  INPUT "DO YOU WANT ANOTHER RUN? Y/N";T$
  83. 701  IF T$="Y" THEN CLS : GOTO 190
  84. 702  IF T$="N" THEN CLS : PRINT "FINIS"
  85. 703  IF T$="y" THEN CLS : GOTO 190
  86. 704  IF T$="n" THEN CLS : PRINT "FINIS"
  87. 705  END
  88. 720  GOTO 190
  89. 1000  REM  -MINMUF 3.5
  90. 1001  REM
  91. 1010  K7=SIN (L1)*SIN(L2)+COS(L1)*COS(L2)*COS (W2-W1)
  92. 1020  IF K7>0.9999 OR K7<-0.999 THEN G1=0:GOTO 1080
  93. 1065  REM
  94. 1070  G1=(-ATN(K7/SQR( -K7*K7+1))+3.1416/2)
  95. 1080  K6=1.59*G1
  96. 1090  IF K6 > = 1 THEN 1110
  97. 1100  K6=1
  98. 1110  K5 = 1 / K6
  99. 1120  J9=100
  100. 1130  FOR K1= 1 / (2 * K6) TO 1 - 1 / (2 * K6) STEP 0.9999 - 1 / K6
  101. 1140  IF K5=1 THEN 1160
  102. 1150  K5=0.5
  103. 1160  P=SIN(L2)
  104. 1170  O= COS (L2)
  105. 1180  A=(SIN(L1)-P*COS(G1))/(O* SIN(G1))
  106. 1190  B=G1*K1
  107. 1200  C=P* COS(B) +O* SIN(B)*A
  108. 1210  D=(COS(B) -C*P)/(O*SQR (1-C^2))
  109. 1220  IF D > -1 THEN 1250
  110. 1230  D= -0.9999
  111. 1240  GOTO 1270
  112. 1250  IF D < =1 THEN 1270
  113. 1260  D= 0.9999
  114. 1270  D= ( - ATN (D/ SQR ( -D * D+1)) + 3.1416 /2)
  115. 1280  W0=W2 + SGN ( SIN (W1 -W2)) * D
  116. 1290  IF W0 = > 0 THEN 1310
  117. 1300  W0=W0 + P1
  118. 1310  IF W0 < P1 THEN 1330
  119. 1320  W0=W0-P1
  120. 1330  IF C= > -1 THEN 1360
  121. 1340  C= -0.999
  122. 1350  GOTO 1380
  123. 1360  IF C < =1 THEN 1380
  124. 1370  C= 0.999
  125. 1380  L0=P0 - ( - ATN (C / SQR( -C*C+1)) + 3.1416/2)
  126. 1390  Y1=0.0172 * (10 + (M0 - 1)* 30.4 + D6)
  127. 1400  Y2= 0.409 * COS (Y1)
  128. 1410  K8= 3.82 * W0 + 12 +0.13*(SIN(Y1) + 1.2 * SIN (2 *Y1))
  129. 1420  K8=K8-12*(1+ SGN(K8-24))*SGN(ABS(K8-24))
  130. 1430  IF COS (L0+Y2) >-0.26 THEN 1520
  131. 1440  K9=0
  132. 1450  G0=0
  133. 1460  M9=2.5*G1*K5
  134. 1470  IF M9<=P0 THEN 1490
  135. 1480  M9=P0
  136. 1490  M9=SIN(M9)
  137. 1500  M9=1+2.5*G1*SQR(M9)
  138. 1510  GOTO 1770
  139. 1520  K9=(-0.26+SIN(Y2)*SIN (L0)) / (COS (Y2)*COS(L0)+0.000999999)
  140. 1530  K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.63944
  141. 1540  T=K8-K9/2+12*(1-SGN(K8-K9/2))*SGN(ABS(K8-K9/2))
  142. 1550  T4=K8+K9/2-12*(1+SGN(K8+K9/2-24))*SGN(ABS(K8+K9/2-24))
  143. 1560  C0=ABS(COS(L0+Y2))
  144. 1570  T9=9.7*C0^9.6
  145. 1580  IF T9>0.1 THEN 1600
  146. 1590  T9=0.1
  147. 1600  M9=2.5*G1*K5
  148. 1610  IF M9 < =P0 THEN 1630
  149. 1620  M9=P0
  150. 1630  M9=SIN(M9)
  151. 1640  M9=1+2.5*M9*SQR(M9)
  152. 1650  IF T4 < T THEN 1680
  153. 1660  IF (T5-T)*(T4-T5)>0 THEN 1690
  154. 1670  GOTO 1820
  155. 1680  IF (T5-T4)*(T-T5)>0 THEN 1820
  156. 1690  T6=T5+12*(1+SGN(T-T5))*SGN(ABS(T-T5))
  157. 1700  G9=3.1416 * (T6-T)/K9
  158. 1710  G8=3.1416 * T9/K9
  159. 1720  U=(T-T6)/T9
  160. 1730  G0=C0*(SIN(G9)+G8*(EXP(U)-COS(G9)))/(1+G8*G8)
  161. 1740  G7=C0*(G8*(EXP(-K9/T9)+1))*EXP((K9-24)/2)/(1+G8*G8)
  162. 1750  IF G0=>G7 THEN 1770
  163. 1760  G0=G7
  164. 1770  G2=(1+S9/250)*M9*SQR(6+58*SQR(G0))
  165. 1780  G2=G2*(1-0.1*EXP((K9-24)/3))
  166. 1790  G2=G2*(1+(1-SGN(L1)*SGN(L2))*0.1)
  167. 1800  G2=G2*(1-0.1*(1+SGN(ABS(SIN(L0))-COS(L0))))
  168. 1810  GOTO 1880
  169. 1820  T6=T5+12*(1+SGN(T4-T5))*SGN(ABS(T4-T5))
  170. 1830  G8=3.1416*T9/K9
  171. 1840  U=(T4-T6)/2
  172. 1850  U1= -K9/T9
  173. 1860  G0=C0*(G8*(EXP(U1)+1))*EXP(U)/(1+G8*G8)
  174. 1870  GOTO 1770
  175. 1880  IF G2 > J9 THEN 1900
  176. 1890  J9=G2
  177. 1900  NEXT K1
  178. 1910  RETURN
  179. 2990  END
  180. 3000  REM SUB FOR ACOS
  181. 3030  DEF FN C(X)=(-ATN(X/SQR(-X*X+1))+/2):RETURN
  182. 3990  S1=155
  183. 4000  REM SUB SOLAR FLUX TO SUNSPOT NO
  184. 4010  S9=10.7626-(2.59987*S)
  185. 4020  S9=S9+(0.0544131*S^2)
  186. 4030  S9=S9-(0.000221346*S^3)
  187. 4040  S9=S9-(1.07083E-06*S^4)
  188. 4050  S9=S9+(7.40653E-09*S^5)
  189. 4060  S9=S9+(2.83302E-11*S^6)
  190. 4070  S9=S9-(2.7019E-13*S^7)
  191. 4080  S9=S9+(4.8E-16*S^8)
  192. 4090  RETURN
  193. 4999  REM LIST OF SPECIFIC RECVR LOC
  194. 5000  IF Z<  >1 THEN 5020
  195. 5010  L2=50:W2=0
  196. 5011  CT$="CALCULATING MUF TO ENGLAND"
  197. 5020  IF Z<  >2 THEN 5060
  198. 5040  L2=40
  199. 5041  CT$="CALCULATING MUF TO ITALY"
  200. 5050  W2=-15
  201. 5060  IF Z <  > 3 THEN 5090
  202. 5070  L2=40
  203. 5071  CT$="CALCULATING MUF TO TURKEY"
  204. 5080  W2=-16
  205. 5081  CT$="CALCULATING MUF TO TURKEY"
  206. 5090  IF Z <  > 4 THEN 6020
  207. 6000  L2=30
  208. 6001  CT$="CALCULATING MUF TO EGYPT"
  209. 6010  W2=-16
  210. 6011  CT$="CALCULATING MUF TO EGYPT"
  211. 6020  IF Z <  > 5 THEN 6060
  212. 6030  L2=-38
  213. 6040  W2=-20
  214. 6041  CT$="CALCULATING MUF TO SO.AFRICA"
  215. 6060  IF Z <  > 6 THEN 6090
  216. 6070  L2=-40
  217. 6080  W2=180
  218. 6081  CT$="CALCULATING MUF TO NEW ZEALAND"
  219. 6090  IF Z <  >7 THEN 7020
  220. 6091  CT$="CALCULATING MUF TO AUSTRALIA"
  221. 7000  L2=-30
  222. 7010  W2=-140
  223. 7020  IF Z <  > 8 THEN 7050
  224. 7021  CT$="CALCULATING MUF TO JAPAN"
  225. 7030  L2=38
  226. 7040  W2=-140
  227. 7050  IF Z <   > 9 THEN 7080
  228. 7051  CT$="CALCULATING MUF TO HAWAI"
  229. 7060  L2=20
  230. 7070  W2=160
  231. 7080  IF Z <   > 10 THEN 8010
  232. 7081  CT$="CALCULATING MUF TO ALASKA"
  233. 7090  L2=70
  234. 8000  W2=160
  235. 8010  IF Z <  > = 11 THEN 8040
  236. 8011  CT$="CALCULATING MUF TO GREENLAND"
  237. 8020  L2=70
  238. 8030  W2=40
  239. 8040  IF Z <   >12 THEN 8070
  240. 8041  CT$="CALCULATING MUF TO BRAZIL"
  241. 8050  L2=-20
  242. 8060  W2=+50
  243. 8070  IF Z <  > 13 THEN 9000
  244. 8080  PRINT "ENTER LAT...LONG.(PLUS VALUE LONGITUDE WEST )"
  245. 8082  PRINT
  246. 8083  INPUT "LATITUDE ?=";L2
  247. 8084  INPUT "LONGITUDE?=";W2
  248. 9000  IF Z > =1 THEN 9001
  249. 9001  IF Z<  =13 THEN 9030
  250. 9010  PRINT "INVALID ENTRY": STOP
  251. 9030  RETURN
  252.